unit uPlacement ;

interface

uses
  Types,
  SysUtils,
  Classes,
  Contnrs,
  Graphics,
  Windows,
  VirtualTrees,
  uBasic,
  uObjects,
  GDIPOBJ,
  GDIPAPI ;

type
  TOnPositionChangeEvent = procedure of object ;

  TMedaView = class( TMedaViewable )
  private
    fOwner : TMedaObject ;
    fViewer : TMedaAbstractPlace ;
    fHelper : TMedaHelper ;

    procedure SetViewer( aViewer : TMedaAbstractPlace ) ; virtual ;
    procedure SetOwner( const Value : TMedaObject ) ; virtual ;

    procedure DoPaint( aGraphics : TMedaGraphics ) ; virtual ;
    function GetLayer : TMedaLayerType ;
    function GetPage : TMedaPageNumber ;
    procedure SetHelper( const Value : TMedahelper ) ;
  public
    function HitTest( aPoint : TGPPointF ; aGraphics : TMedaGraphics ) : boolean ; virtual ;
    procedure PaintAt( aGraphics : TMedaGraphics ) ; virtual ;
  public
    function GetName : string ; override ;
    procedure SetName( const aName : string ) ; override ;
    function GetSelection : TMedaState ; override ;
    procedure SetSelection( aFlag : TMedaState ) ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
  public
    constructor Create( aOwner : TMedaObject ) ;
    destructor Destroy ; override ;

    function Accept( Visitor : TObject ) : TObject ; override ;

    property Owner : TMedaObject read fOwner write SetOwner ;
    procedure Place( aPlace : TMedaViewable ) ; virtual ;
    function IsPlaced : boolean ; override ;
    function Show : TPoint ; override ;

    property Helper : TMedahelper read fHelper write SetHelper ;
    property Viewer : TMedaAbstractPlace read fViewer write SetViewer ;
    property LayerType : TMedaLayerType read GetLayer ;
    property PageNumber : TMedaPageNumber read GetPage ;

    procedure Invalidate ; override ;
  end ;

  TMedaViewList = class
  private
    fObjects : TObjectlist ;
    fPlace : TMedaAbstractPlace ;
    function GetItem( aIndex : Integer ) : TMedaView ; virtual ;
    procedure SetItem( aIndex : Integer ; const aObject : TMedaView ) ; virtual ;
    function GetCount : integer ; virtual ;
    procedure SetPlace( const Value : TMedaAbstractPlace ) ;
  public
    constructor Create ;
    destructor Destroy ; override ;

    property Views[ Index : Integer ] : TMedaView read GetItem write SetItem ; default ;
    property Count : integer read GetCount ;
    procedure Remove( aView : TMedaViewable ) ;
    procedure Clear ; virtual ;
    procedure Assign( const aObject : TMedaViewList ) ; virtual ;
    function Add( const aObject : TMedaView ) : integer ;
    function FirstView : TMedaView ; virtual ;
    property Place : TMedaAbstractPlace read fPlace write SetPlace ;
  end ;

  TMedaViewClass = class of TMedaView ;

  TMSPOutline = class( TMedaView )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPModule = class( TMSPOutline )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPBank = class( TMSPOutline )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPShape = class( TMSPOutline )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPWire = class( TMedaView )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
    function HitTest( aPoint : TGPPointF ; aGraphics : TMedaGraphics ) : boolean ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPTrack = class( TMedaView )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
    function HitTest( aPoint : TGPPointF ; aGraphics : TMedaGraphics ) : boolean ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPPin = class( TMedaView )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPPort = class( TMSPPin )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPLabel = class( TMedaView )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPPower = class( TMSPLabel )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMSPPad = class( TMedaView )
  private
    fAperture : TObject ;
    procedure SetAperture( const Value : TObject ) ; virtual ;
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    property Aperture : TObject read fAperture write SetAperture ;
  end ;

  TMSPCopper = class( TMedaView )
  private
    procedure DoPaint( aGraphics : TMedaGraphics ) ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

implementation

uses
  uLayout,
  uViewPCB,
  uViewSchematic,
  uVisitor,
  uViewFactory,
  XMLDoc ;

var
  gFontFamily       : TGPFontFamily ;
  gFontSch          : TGPFont ;
  gFontPCB          : TGPFont ;

  gTextBrush        : TGPSolidBrush ;
  gSchemBrush       : TGPSolidBrush ;
  gLayoutBrush      : TGPSolidBrush ;

  gSFLeftCenter     : TGPStringFormat ;
  gSFRightCenter    : TGPStringFormat ;
  gSFLeftTop        : TGPStringFormat ;
  gSFCenterBottom   : TGPStringFormat ;
  gSFCenterCenter   : TGPStringFormat ;

  gBodyPen          : TGPPen ;
  gMechPen          : TGPPen ;
  gBodyPenOff       : TGPPen ;
  gBodyPenSel       : TGPPen ;

  gLinePen          : TGPPen ;
  gLinePenSel       : TGPPen ;

  gTrackPenTrue     : TGPPen ;
  gTrackPenMaybe    : TGPPen ;
  gTrackPenFalse    : TGPPen ;

  gLabelBrush       : TGPSolidBrush ;
  gTrackBrush       : TGPSolidBrush ;
  gTrackBrushSel    : TGPSolidBrush ;

  gPinPen           : TGPPen ;
  gPinPenOff        : TGPPen ;
  gPinPenSel        : TGPPen ;

  { TMedaView }

constructor TMedaView.Create( aOwner : TMedaObject ) ;
begin
  inherited Create ;
  fOwner := aOwner ;
end ;

procedure TMedaView.Place( aPlace : TMedaViewable ) ;
begin
  ( aPlace as TMedaPlace ).Add( Self ) ;
  Invalidate ;
end ;

function TMedaView.IsPlaced : boolean ;
begin
  Result := assigned( fViewer ) ;
end ;

procedure TMedaView.SetViewer( aViewer : TMedaAbstractPlace ) ;
begin
  fViewer := aViewer ;
  Invalidate ;
end ;

procedure TMedaView.Invalidate ;
var
  iBounds           : TGPRectF ;
begin
  Assert( assigned( fOwner ) ) ;
  if assigned( fViewer ) then begin
    iBounds := fOwner.Bounds ;
    GPInflateRect( iBounds, 48 ) ;
    TMedaPlace( fViewer ).InvalRect( iBounds ) ;
  end ;
end ;

function TMedaView.HitTest( aPoint : TGPPointF ; aGraphics : TMedaGraphics ) : boolean ;
var
  r                 : TGPRectF ;
begin
  Assert( assigned( fOwner ) ) ;
  r := fOwner.Bounds ;
  GPInflateRect( r, 10 ) ;
  Result := GPPtInRect( r, aPoint ) ;
end ;

function TMedaView.GetIcon : TIconType ;
begin
  Assert( assigned( fOwner ) ) ;
  Result := fOwner.GetIcon ;
end ;

function TMedaView.GetName : string ;
begin
  Assert( assigned( fOwner ) ) ;
  Result := fOwner.GetName ;
end ;

function TMedaView.GetSelection : TMedaState ;
begin
  Assert( assigned( fOwner ) ) ;
  Result := fOwner.GetSelection ;
end ;

procedure TMedaView.SetSelection( aFlag : TMedaState ) ;
begin
  inherited ;
  Assert( assigned( fOwner ) ) ;
  if fOwner.GetSelection <> aFlag then begin
    fOwner.SetSelection( aFlag ) ;
    Invalidate ;
  end ;
end ;

function TMedaView.GetText( aColumn : integer ) : string ;
begin
  Result := fOwner.GetText( aColumn ) ;
end ;

procedure TMedaView.SetHelper( const Value : TMedahelper ) ;
begin
  fHelper := Value ;
end ;

procedure TMedaView.SetName( const aName : string ) ;
begin
  inherited ;
  Assert( assigned( fOwner ) ) ;
  fOwner.SetName( aName ) ;
  Invalidate ;
end ;

destructor TMedaView.Destroy ;
begin
  if assigned( Viewer ) then
    ( Viewer as TMedaPlace ).Remove( Self ) ;
  if assigned( fOwner ) then
    Owner.View := nil ;
  inherited ;
end ;

procedure TMedaView.DoPaint( aGraphics : TMedaGraphics ) ;
begin
  Assert( assigned( fOwner ) ) ;
end ;

procedure TMedaView.PaintAt( aGraphics : TMedaGraphics ) ;
begin
  Assert( assigned( fOwner ) ) ;
  if GPIntersect( fOwner.Bounds, aGraphics.View ) then
    with aGraphics do try
      MemGraphics.TranslateTransform( fOwner.Transforms[ 0 ].Position.X, fOwner.Transforms[ 0 ].Position.Y ) ;
      if fOwner.Transforms[ 0 ].Mirror then
        MemGraphics.ScaleTransform( -1, 1 ) ;
      MemGraphics.RotateTransform( -fOwner.Transforms[ 0 ].Rotation ) ;
      DoPaint( aGraphics ) ;
    finally
      MemGraphics.RotateTransform( fOwner.Transforms[ 0 ].Rotation ) ;
      if fOwner.Transforms[ 0 ].Mirror then
        MemGraphics.ScaleTransform( -1, 1 ) ;
      MemGraphics.TranslateTransform( -fOwner.Transforms[ 0 ].Position.X, -fOwner.Transforms[ 0 ].Position.Y ) ;
    end ;
end ;

function TMedaView.GetColor : TGPColor ;
begin
  Result := aclMedaView ;
end ;

procedure TMedaView.SetOwner( const Value : TMedaObject ) ;
begin
  fOwner := Value ;
end ;

function TMedaView.Show : TPoint ;
begin
  Result := inherited Show ;
  if assigned( fViewer ) then
    Result := fViewer.Center( fOwner.Bounds ) ;
end ;

function TMedaView.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaView.GetLayer : TMedaLayerType ;
begin
  Result := lcNone ;
  if assigned( fViewer ) then
    Result := ( fViewer as TMedaLayer ).LayerType ;
end ;

function TMedaView.GetPage : TMedaPageNumber ;
begin
  Result := -1 ;
  if assigned( fViewer ) then
    Result := ( fViewer as TMedaPage ).Number ;
end ;

{ TMSPWire }

procedure TMSPWire.DoPaint( aGraphics : TMedaGraphics ) ;
begin
  Assert( assigned( fOwner ) ) ;
  with aGraphics do begin
    if fOwner.GetSelection <> triFalse then
      MemGraphics.DrawPath( gLinePenSel, fOwner.Path )
    else
      MemGraphics.DrawPath( gLinePen, fOwner.Path ) ;
    MemGraphics.DrawLine( gPinPenOff, -cSchGrid / 4, +cSchGrid / 4, +cSchGrid / 4, -cSchGrid / 4 ) ;
    MemGraphics.DrawLine( gPinPenOff, -cSchGrid / 4, -cSchGrid / 4, +cSchGrid / 4, +cSchGrid / 4 ) ;
  end ;
end ;

function TMSPWire.HitTest( aPoint : TGPPointF ; aGraphics : TMedaGraphics ) : boolean ;
var
  a2, n2, d1, dx, dy : single ;
  A, B, P           : TGPPointF ;
begin
  Result := inherited HitTest( aPoint, aGraphics ) ;
  if Result then begin
    ( fOwner as TMedaWire ).GetPoints( A, B ) ;
    P := aPoint ;
    dx := B.x - A.x ;
    dy := B.y - A.y ;
    n2 := dy * dy + dx * dx ;
    if n2 < cSchGrid then
      Exit ;
    a2 := ( P.y - A.y ) * dx - ( P.x - A.x ) * dy ;
    d1 := a2*a2 / n2 ;
    Result := abs( d1 ) < 0.5 * cSchGrid * cSchGrid ;
  end ;
end ;

function TMSPWire.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMSPTrack }

procedure TMSPTrack.DoPaint( aGraphics : TMedaGraphics ) ;
begin
  Assert( assigned( fOwner ) ) ;
  with aGraphics do begin
    case fOwner.GetSelection of
      triTrue : begin
          gTrackPenTrue.SetWidth( TMedaTrack( fOwner ).Width ) ;
          MemGraphics.DrawPath( gTrackPenTrue, fOwner.Path )
        end ;
      triMaybe : begin
          gTrackPenMaybe.SetWidth( TMedaTrack( fOwner ).Width ) ;
          MemGraphics.DrawPath( gTrackPenMaybe, fOwner.Path )
        end ;
    else
      gTrackPenFalse.SetWidth( TMedaTrack( fOwner ).Width ) ;
      gTrackPenFalse.SetColor( GetPCBLayerColor( TMedaLayer( fViewer ).LayerType ) ) ;
      MemGraphics.DrawPath( gTrackPenFalse, fOwner.Path ) ;
    end ;
    MemGraphics.DrawLine( gPinPenOff, -cPCBGrid / 4, +cPCBGrid / 4, +cPCBGrid / 4, -cPCBGrid / 4 ) ;
    MemGraphics.DrawLine( gPinPenOff, -cPCBGrid / 4, -cPCBGrid / 4, +cPCBGrid / 4, +cPCBGrid / 4 ) ;
  end ;
end ;

function TMSPTrack.HitTest( aPoint : TGPPointF ;
  aGraphics : TMedaGraphics ) : boolean ;
var
  a2, n2, d1, dx, dy, w : single ;
  A, B, P           : TGPPointF ;
begin
  Result := inherited HitTest( aPoint, aGraphics ) ;
  if Result then begin
    ( fOwner as TMedaWire ).GetPoints( A, B ) ;
    P := aPoint ;
    dx := B.x - A.x ;
    dy := B.y - A.y ;
    n2 := dy * dy + dx * dx ;
    if n2 < cPCBGrid then
      Exit ;
    a2 := ( P.y - A.y ) * dx - ( P.x - A.x ) * dy ;
    d1 := a2*a2 / n2 ;
    w := ( fOwner as TMedaTrack ).Width ;
    Result := abs( d1 ) < w * w ;
  end ;
end ;

function TMSPTrack.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMSPOutline }

procedure TMSPOutline.DoPaint( aGraphics : TMedaGraphics ) ;
var
  rf                : TGPRectF ;
  s                 : string ;
begin
  Assert( assigned( fOwner ) ) ;
  with aGraphics do begin
    MemGraphics.FillPath( gSchemBrush, fOwner.Path ) ;
    if fOwner.GetSelection <> triFalse then
      MemGraphics.DrawPath( gBodyPenSel, fOwner.Path )
    else
      MemGraphics.DrawPath( gBodyPen, fOwner.Path ) ;
    MemGraphics.DrawLine( gPinPenOff, -cSchGrid / 2, +cSchGrid / 2, +cSchGrid / 2, -cSchGrid / 2 ) ;
    MemGraphics.DrawLine( gPinPenOff, -cSchGrid / 2, -cSchGrid / 2, +cSchGrid / 2, +cSchGrid / 2 ) ;

    rf.X := 0 ;
    rf.Y := 0 ;
    rf.Width := cSchGrid * 20 ;
    rf.Height := cSchGrid ;

    MemGraphics.TranslateTransform( fOwner.Transforms[ 1 ].Position.X, fOwner.Transforms[ 1 ].Position.Y ) ;
    if fOwner.Transforms[ 1 ].Mirror then
      MemGraphics.ScaleTransform( -1, 1 ) ;
    MemGraphics.RotateTransform( -fOwner.Transforms[ 1 ].Rotation ) ;
    try
      s := fOwner.GetText( 3 ) ;
      MemGraphics.DrawString( s, length( s ), gFontSch, rf, gSFLeftCenter, gTextBrush ) ;
    finally
      MemGraphics.RotateTransform( fOwner.Transforms[ 1 ].Rotation ) ;
      if fOwner.Transforms[ 1 ].Mirror then
        MemGraphics.ScaleTransform( -1, 1 ) ;
      MemGraphics.TranslateTransform( -fOwner.Transforms[ 1 ].Position.X, -fOwner.Transforms[ 1 ].Position.Y ) ;
    end ;

    MemGraphics.TranslateTransform( fOwner.Transforms[ 2 ].Position.X, fOwner.Transforms[ 2 ].Position.Y ) ;
    if fOwner.Transforms[ 2 ].Mirror then
      MemGraphics.ScaleTransform( -1, 1 ) ;
    MemGraphics.RotateTransform( -fOwner.Transforms[ 2 ].Rotation ) ;
    try
      s := fOwner.GetText( 4 ) ;
      MemGraphics.DrawString( s, length( s ), gFontSch, rf, gSFLeftCenter, gTextBrush ) ;
    finally
      MemGraphics.RotateTransform( fOwner.Transforms[ 2 ].Rotation ) ;
      if fOwner.Transforms[ 2 ].Mirror then
        MemGraphics.ScaleTransform( -1, 1 ) ;
      MemGraphics.TranslateTransform( -fOwner.Transforms[ 2 ].Position.X, -fOwner.Transforms[ 2 ].Position.Y ) ;
    end ;
  end ;
end ;

function TMSPOutline.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMSPModule }

function TMSPModule.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMSPBank }

function TMSPBank.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMSPShape }

function TMSPShape.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMSPShape.DoPaint( aGraphics : TMedaGraphics ) ;
var
  rf                : TGPRectF ;
  s                 : string ;
begin
  Assert( assigned( fOwner ) ) ;
  with aGraphics do begin
    //        MemGraphics.FillPath( gLayoutBrush, fOwner.Path ) ;
    if fOwner.GetSelection <> triFalse then
      MemGraphics.DrawPath( gBodyPenSel, fOwner.Path )
    else
      MemGraphics.DrawPath( gMechPen, fOwner.Path ) ;
    MemGraphics.DrawLine( gPinPenOff, -cPCBGrid / 2, +cPCBGrid / 2, +cPCBGrid / 2, -cPCBGrid / 2 ) ;
    MemGraphics.DrawLine( gPinPenOff, -cPCBGrid / 2, -cPCBGrid / 2, +cPCBGrid / 2, +cPCBGrid / 2 ) ;

    rf.X := 0 ;
    rf.Y := 0 ;
    rf.Width := cPCBGrid * 20 ;
    rf.Height := cPCBGrid ;

    MemGraphics.TranslateTransform( fOwner.Transforms[ 1 ].Position.X, fOwner.Transforms[ 1 ].Position.Y ) ;
    if fOwner.Transforms[ 1 ].Mirror then
      MemGraphics.ScaleTransform( -1, 1 ) ;
    MemGraphics.RotateTransform( -fOwner.Transforms[ 1 ].Rotation ) ;
    try
      s := fOwner.GetText( 3 ) ;
      MemGraphics.DrawString( s, length( s ), gFontPCB, rf, gSFLeftCenter, gLayoutBrush ) ;
    finally
      MemGraphics.RotateTransform( fOwner.Transforms[ 1 ].Rotation ) ;
      if fOwner.Transforms[ 1 ].Mirror then
        MemGraphics.ScaleTransform( -1, 1 ) ;
      MemGraphics.TranslateTransform( -fOwner.Transforms[ 1 ].Position.X, -fOwner.Transforms[ 1 ].Position.Y ) ;
    end ;

    MemGraphics.TranslateTransform( fOwner.Transforms[ 2 ].Position.X, fOwner.Transforms[ 2 ].Position.Y ) ;
    if fOwner.Transforms[ 2 ].Mirror then
      MemGraphics.ScaleTransform( -1, 1 ) ;
    MemGraphics.RotateTransform( -fOwner.Transforms[ 2 ].Rotation ) ;
    try
      s := fOwner.GetText( 4 ) ;
      MemGraphics.DrawString( s, length( s ), gFontPCB, rf, gSFLeftCenter, gLayoutBrush ) ;
    finally
      MemGraphics.RotateTransform( fOwner.Transforms[ 2 ].Rotation ) ;
      if fOwner.Transforms[ 2 ].Mirror then
        MemGraphics.ScaleTransform( -1, 1 ) ;
      MemGraphics.TranslateTransform( -fOwner.Transforms[ 2 ].Position.X, -fOwner.Transforms[ 2 ].Position.Y ) ;
    end ;
  end ;
end ;

{ TMSPLabel }

function TMSPLabel.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMSPLabel.DoPaint( aGraphics : TMedaGraphics ) ;
var
  iText             : string ;
  bounds            : TGPRectF ;
begin
  Assert( assigned( fOwner ) ) ;
  with aGraphics do
    if aGraphics.ShowLabels then begin
      bounds.X := 2.2 * cSchGrid ;
      bounds.Y := -cSchGrid / 2 ;
      bounds.Width := 2 * cSchGrid + 4 * cSchGrid ;
      bounds.Height := cSchGrid ;
      MemGraphics.FillPath( gLabelBrush, fOwner.Path ) ;
      if not ( vfBody in fOwner.Flags ) then
        MemGraphics.DrawPath( gBodyPenOff, fOwner.Path )
      else if fOwner.GetSelection <> triFalse then
        MemGraphics.DrawPath( gBodyPenSel, fOwner.Path )
      else
        MemGraphics.DrawPath( gBodyPen, fOwner.Path ) ;
      if vfName in fOwner.Flags then begin
        iText := fOwner.GetText( 0 ) ;
        MemGraphics.DrawString( iText, length( iText ), gFontSch, bounds, gSFLeftCenter, gTextBrush ) ;
      end ;
    end ;
end ;

{ TMSPPower }

function TMSPPower.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMSPPower.DoPaint( aGraphics : TMedaGraphics ) ;
var
  iText             : string ;
  bounds            : TGPRectF ;
begin
  with aGraphics do
    if aGraphics.ShowLabels then begin
      if not ( vfBody in fOwner.Flags ) then
        MemGraphics.DrawPath( gBodyPenOff, fOwner.Path )
      else if fOwner.GetSelection <> triFalse then
        MemGraphics.DrawPath( gBodyPenSel, fOwner.Path )
      else
        MemGraphics.DrawPath( gBodyPen, fOwner.Path ) ;
      if vfName in fOwner.Flags then begin
        bounds.X := -2 * cSchGrid ;
        bounds.Y := 0 ;
        bounds.Width := 4 * cSchGrid ;
        bounds.Height := 2 * cSchGrid ;
        iText := fOwner.GetText( 0 ) ;
        MemGraphics.DrawString( iText, length( iText ), gFontSch, bounds, gSFCenterBottom, gTextBrush ) ;
      end ;
    end ;
end ;

{ TMSPPort }

function TMSPPort.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMSPPin }

function TMSPPin.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMSPPin.DoPaint( aGraphics : TMedaGraphics ) ;
var
  iText             : string ;
  bounds            : TGPRectF ;
  ascent            : integer ;
begin
  with aGraphics do try
    MemGraphics.TranslateTransform( TMedaPin( fOwner ).Offset.X, TMedaPin( fOwner ).Offset.Y ) ;
    MemGraphics.RotateTransform( -45 * ord( TMedaPin( fOwner ).Direction ) ) ;

    if aGraphics.View.Width < 2000 then begin
      MemGraphics.FillPath( gLabelBrush, fOwner.Path ) ;
      if not ( vfBody in fOwner.Flags ) then
        MemGraphics.DrawPath( gPinPenOff, fOwner.Path )
      else if fOwner.GetSelection <> triFalse then
        MemGraphics.DrawPath( gPinPenSel, fOwner.Path )
      else
        MemGraphics.DrawPath( gPinPen, fOwner.Path ) ;

      bounds.X := -5 * cSchGrid ;
      bounds.Y := -0.75 * cSchGrid ;
      bounds.Width := 4.8 * cSchGrid ;
      bounds.Height := 1.5 * cSchGrid ;
      if vfName in fOwner.Flags then begin
        iText := fOwner.GetText( 3 ) ;
        if Pos( '\', iText ) <> 0 then begin
          iText := StringReplace( iText, '\', '', [ rfReplaceAll ] ) ;
          ascent := gFontFamily.GetCellAscent( FontStyleRegular ) ;
          ascent := Round( gFontSch.GetSize * ascent / gFontFamily.GetEmHeight( FontStyleRegular ) ) ;
          MemGraphics.DrawLine( gLinePen, -cSchGrid * length( iText ) / 2 + 1, -ascent / 2 - 1, -1, -ascent / 2 - 1 ) ;
        end ;
        MemGraphics.DrawString( iText, length( iText ), gFontSch, bounds, gSFRightCenter, gTextBrush ) ;
      end ;
      if vfDesignator in fOwner.Flags then begin
        bounds.X := 0.2 * cSchGrid ;
        iText := fOwner.GetText( 4 ) ;
        MemGraphics.DrawString( iText, length( iText ), gFontSch, bounds, gSFLeftTop, gTextBrush ) ;
      end ;
    end ;
  finally
    MemGraphics.RotateTransform( 45 * ord( TMedaPin( fOwner ).Direction ) ) ;
    MemGraphics.TranslateTransform( -TMedaPin( fOwner ).Offset.X, -TMedaPin( fOwner ).Offset.Y ) ;
  end ;
end ;

{ TMSPCopper }

function TMSPCopper.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMSPCopper.DoPaint( aGraphics : TMedaGraphics ) ;
var
  iCopper           : TMedaCopper ;
begin
  with aGraphics.MemGraphics do begin
    iCopper := fOwner as TMedaCopper ;
    if iCopper.GetSelection <> triFalse then begin
      FillPath( gTrackBrushSel, fOwner.Path )
    end
    else begin
      gTrackBrush.SetColor( GetPCBLayerColor( TMedaLayer( fViewer ).LayerType ) ) ;
      FillPath( gTrackBrush, fOwner.Path ) ;
    end ;
  end ;
end ;

{ TMSPPad }

procedure TMSPPad.SetAperture( const Value : TObject ) ;
begin
  fAperture := Value ;
end ;

procedure TMSPPad.DoPaint( aGraphics : TMedaGraphics ) ;
var
  bounds            : TGPRectF ;
  iText             : string ;
  iStack            : TMedaStack ;
begin
  with aGraphics.MemGraphics do begin
    iStack := fOwner.Parent as TMedaStack ;
    TranslateTransform( iStack.Offset.X, iStack.Offset.Y ) ;
    try
      if fOwner.GetSelection <> triFalse then begin
        FillPath( gTrackBrushSel, fOwner.Path )
      end
      else begin
        gTrackBrush.SetColor( GetPCBLayerColor( TMedaLayer( fViewer ).LayerType ) ) ;
        FillPath( gTrackBrush, fOwner.Path ) ;
      end ;
      if aGraphics.ShowPadNumbers then begin
        if vfDesignator in fOwner.Flags then begin
          bounds.X := -1 * cPCBGrid ;
          bounds.Y := -1 * cPCBGrid ;
          bounds.Width := 2 * cPCBGrid ;
          bounds.Height := 2 * cPCBGrid ;
          iText := fOwner.Parent.GetText( 1 ) ;
          DrawString( iText, length( iText ), gFontSch, bounds, gSFCenterCenter, gTextBrush ) ;
        end ;
      end ;
    finally
      TranslateTransform( -iStack.Offset.X, -iStack.Offset.Y ) ;
    end ;
  end ;
end ;

function TMSPPad.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaViewList }

function TMedaViewList.Add( const aObject : TMedaView ) : integer ;
begin
  Result := fObjects.Add( aObject ) ;
end ;

procedure TMedaViewList.Assign( const aObject : TMedaViewList ) ;
begin
  fObjects.Assign( aObject.fObjects ) ;
  fPlace := aObject.Place ;
end ;

procedure TMedaViewList.Clear ;
begin
  fObjects.Clear ;
end ;

constructor TMedaViewList.Create ;
begin
  inherited ;
  fObjects := TObjectlist.Create( False ) ;
  fPlace := nil ;
end ;

destructor TMedaViewList.Destroy ;
begin
  fObjects.Free ;
  inherited ;
end ;

function TMedaViewList.FirstView : TMedaView ;
begin
  Result := nil ;
  if fObjects.Count > 0 then
    Result := fObjects[ 0 ] as TMedaView ;
end ;

function TMedaViewList.GetCount : integer ;
begin
  Result := fObjects.Count ;
end ;

function TMedaViewList.GetItem( aIndex : Integer ) : TMedaView ;
begin
  Result := nil ;
  if fObjects.Count > aIndex then
    Result := fObjects[ aIndex ] as TMedaView ;
end ;

procedure TMedaViewList.Remove( aView : TMedaViewable ) ;
begin
  fObjects.Remove( aView ) ;
end ;

procedure TMedaViewList.SetItem( aIndex : Integer ; const aObject : TMedaView ) ;
begin
  if fObjects.Count > aIndex then
    fObjects[ aIndex ] := aObject ;
end ;

procedure TMedaViewList.SetPlace( const Value : TMedaAbstractPlace ) ;
begin
  fPlace := Value ;
end ;

initialization

  gFontFamily := TGPFontFamily.Create( 'Courier New' ) ;
  gFontSch := TGPFont.Create( gFontFamily, 7, FontStyleBold, UnitPixel ) ;
  gFontPCB := TGPFont.Create( gFontFamily, 24, FontStyleBold, UnitPixel ) ;

  gTextBrush := TGPSolidBrush.Create( aclTextSch ) ;
  gSchemBrush := TGPSolidBrush.Create( $40FFFFE0 ) ;
  gLayoutBrush := TGPSolidBrush.Create( $40FFFFE0 ) ;

  gBodyPen := TGPPen.Create( aclOutline, 1.5 ) ;
  gBodyPen.SetStartCap( LineCapRound ) ;
  gBodyPen.SetEndCap( LineCapRound ) ;
  gBodyPen.SetLineJoin( LineJoinRound ) ;

  gMechPen := TGPPen.Create( GetPCBLayerColor( lcMechanical ), 1.5 ) ;
  gMechPen.SetStartCap( LineCapRound ) ;
  gMechPen.SetEndCap( LineCapRound ) ;
  gMechPen.SetLineJoin( LineJoinRound ) ;

  gBodyPenOff := TGPPen.Create( aclOutlineOff, 2 ) ;
  gBodyPenOff.SetStartCap( LineCapRound ) ;
  gBodyPenOff.SetEndCap( LineCapRound ) ;
  gBodyPenOff.SetLineJoin( LineJoinRound ) ;

  gBodyPenSel := TGPPen.Create( aclOutlineSel, 2 ) ;
  gBodyPenSel.SetStartCap( LineCapRound ) ;
  gBodyPenSel.SetEndCap( LineCapRound ) ;
  gBodyPenSel.SetLineJoin( LineJoinRound ) ;

  gLinePen := TGPPen.Create( aclLine, 1.5 ) ;
  gLinePen.SetStartCap( LineCapRound {Anchor} ) ;
  gLinePen.SetEndCap( LineCapRound ) ;
  gLinePen.SetLineJoin( LineJoinRound ) ;
  gLinePenSel := TGPPen.Create( aclPinSel, 2 ) ;
  gLinePenSel.SetStartCap( LineCapRound ) ;
  gLinePenSel.SetEndCap( LineCapRound ) ;
  gLinePenSel.SetLineJoin( LineJoinRound ) ;

  gTrackPenFalse := TGPPen.Create( aclTrackFalse, 1 ) ;
  gTrackPenFalse.SetStartCap( LineCapRound ) ;
  gTrackPenFalse.SetEndCap( LineCapRound ) ;
  gTrackPenFalse.SetLineJoin( LineJoinRound ) ;

  gTrackPenMaybe := TGPPen.Create( aclTrackMaybe, 1 ) ;
  gTrackPenMaybe.SetStartCap( LineCapRound ) ;
  gTrackPenMaybe.SetEndCap( LineCapRound ) ;
  gTrackPenMaybe.SetLineJoin( LineJoinRound ) ;

  gTrackPenTrue := TGPPen.Create( aclTrackTrue, 1 ) ;
  gTrackPenTrue.SetStartCap( LineCapRound ) ;
  gTrackPenTrue.SetEndCap( LineCapRound ) ;
  gTrackPenTrue.SetLineJoin( LineJoinRound ) ;

  gLabelBrush := TGPSolidBrush.Create( $40FFFFE0 ) ;

  gTrackBrush := TGPSolidBrush.Create( aclOutline ) ;
  gTrackBrushSel := TGPSolidBrush.Create( aclPinSel ) ;

  gPinPen := TGPPen.Create( aclPin, 1.5 ) ;
  gPinPen.SetStartCap( LineCapTriangle ) ;
  gPinPen.SetEndCap( LineCapTriangle ) ;
  gPinPen.SetLineJoin( LineJoinRound ) ;
  gPinPenOff := TGPPen.Create( aclPinOff, 1 ) ;
  gPinPenOff.SetStartCap( LineCapTriangle ) ;
  gPinPenOff.SetEndCap( LineCapTriangle ) ;
  gPinPenSel := TGPPen.Create( aclPinSel, 2 ) ;
  gPinPenSel.SetStartCap( LineCapDiamondAnchor ) ;
  gPinPenSel.SetEndCap( LineCapDiamondAnchor ) ;

  gSFLeftCenter := TGPStringFormat.Create( StringFormatFlagsNoWrap or StringFormatFlagsNoClip, LANG_NEUTRAL ) ;
  gSFLeftCenter.SetAlignment( StringAlignmentNear ) ;
  gSFLeftCenter.SetLineAlignment( StringAlignmentCenter ) ;
  gSFLeftCenter.SetTrimming( StringTrimmingEllipsisCharacter ) ;

  gSFRightCenter := TGPStringFormat.Create( StringFormatFlagsNoWrap or StringFormatFlagsNoClip, LANG_NEUTRAL ) ;
  gSFRightCenter.SetAlignment( StringAlignmentFar ) ;
  gSFRightCenter.SetLineAlignment( StringAlignmentCenter ) ;
  gSFRightCenter.SetTrimming( StringTrimmingEllipsisCharacter ) ;

  gSFLeftTop := TGPStringFormat.Create( StringFormatFlagsNoWrap or StringFormatFlagsNoClip, LANG_NEUTRAL ) ;
  gSFLeftTop.SetAlignment( StringAlignmentNear ) ;
  gSFLeftTop.SetLineAlignment( StringAlignmentNear ) ;
  gSFLeftTop.SetTrimming( StringTrimmingEllipsisCharacter ) ;

  gSFCenterBottom := TGPStringFormat.Create( StringFormatFlagsNoWrap or StringFormatFlagsNoClip, LANG_NEUTRAL ) ;
  gSFCenterBottom.SetAlignment( StringAlignmentCenter ) ;
  gSFCenterBottom.SetLineAlignment( StringAlignmentFar ) ;
  gSFCenterBottom.SetTrimming( StringTrimmingEllipsisCharacter ) ;

  gSFCenterCenter := TGPStringFormat.Create( StringFormatFlagsNoWrap or StringFormatFlagsNoClip, LANG_NEUTRAL ) ;
  gSFCenterCenter.SetAlignment( StringAlignmentCenter ) ;
  gSFCenterCenter.SetLineAlignment( StringAlignmentCenter ) ;
  gSFCenterCenter.SetTrimming( StringTrimmingEllipsisCharacter ) ;

finalization

  gSFLeftCenter.Free ;
  gSFCenterBottom.Free ;
  gSFLeftTop.Free ;
  gSFRightCenter.Free ;
  gSFCenterCenter.Free ;

  gBodyPen.Free ;
  gMechPen.Free ;
  gBodyPenOff.Free ;
  gBodyPenSel.Free ;

  gLinePen.Free ;
  gLinePenSel.Free ;

  gTrackPenFalse.Free ;
  gTrackPenMaybe.Free ;
  gTrackPenTrue.Free ;

  gLabelBrush.Free ;
  gTrackBrush.Free ;
  gTrackBrushSel.Free ;

  gPinPen.Free ;
  gPinPenOff.Free ;
  gPinPenSel.Free ;

  gSchemBrush.Free ;
  gTextBrush.Free ;

  gLayoutBrush.Free ;

  gFontPCB.Free ;
  gFontSch.Free ;
  gFontFamily.Free ;

end.

